Pascal Super Library/Pascal Super Library (CW International)(1997).bin/LIBRARY/MCQUAY1/FILEIO6.PAS

Pascal/Delphi Source File | 1995-05-22 | 17KB | 501 lines

unit fileio6;
{**************************************************************************
   ADVANCED FILE IO FOR TURBO PASCAL VER 6.0
   Copyright 1991 McQuay Technologies
   r.quay
   ver 6.1
   Dec 17 1991
   McQuay Technologies
   2329 E.Cortez
   Phoenix AZ, 85028
   Compuserve ID

   These routines extend the File I/O capabilties of Turbo Pascal Version
   6.0 and 7.0 .  They permit rapid random access file I/O on unstructured
   or varied structure files.  They can be mixed freely with all
   the standard pascal I/O procedures and functions, however,
   these extensions do effect the behavior of Turbo's standard
   I/O procedures and functions in very predicatble ways.
   There in lies the power and flexibility of these routines.

   It is reccomended that only experienced programmers attempt to utilize
   these routines.

   DOS Versions MS/PC DOS  2.x,3.x,4.x,5.x
   Turbo Versions 6.0 and 7.0 Only !!!

**************************************************************************}

interface
  uses dos;
  Type
        TFileStatus = (unassigned,Closed,Open,Unknown);
        TFilePath = string[80];
  function AbsoluteSeek( Var FileType; fileOffset:longint;
                         var FilePos:longint):word;
   function RelativeSeek( Var FileType; RelativeOffset:longint;
                          var FilePos:longint):word;
  procedure EOFSeek( Var FileType; var Offset:longint; Var Status:word);
  function AbsoluteRead( Var FIleType; Var Buffer; BytesToRead: word;
                         Var BytesRead:word):word;
  function AbsoluteWrite( var FIleType; Var Variable; BytestoWrite:word;
                          var BytesWritten:word):word;
  function FileRecordLength(Var FileType):word;
  function AbsoluteFilePos(Var FileType; Var Status:word):longint;
    function TurboFileStatus(Var FileType):Tfilestatus;
  function TurboFileMode(Var FileType):word;
  function TurboFileHandle(Var FileType):integer;
  procedure ForceUpdate(var FileType; var Status:word);
  function FastBinaryCopy(var FileTypeSource; var FileTypeTarget):word;
    function FIleCopy(Source,Target:TFilePath):word;
implementation

{-------------------------------------------------------------------------}
Function CF(Flags:word):Boolean;
{ Returns TRUE if Carry Flag is set  }
Begin
  if (Flags and $1) = 1 then
    CF := True
  Else
    CF := False;
End;
{-------------------------------------------------------------------------}
{ These 3 proccedures provide direct random access to any file, independent
  of the file's record size or type. (i.e. it works on TEXT filetypes!).

  ABSOLUTESEEK positions the file pointer OFFSET bytes from the beginning
  of the file.  RELATIVESEEK positions the file pointer OFFSET bytes from the
  current position of the file pointer.  EOFSEEK positions the file pointer
  at the end of the file, and returns its position in bytes in OFFSET (This
  of course limits you to a 2 gigabyte file size, too bad).

  These routines can be mixed freely with Turbo's IO procedures, however
  they do have some rather predicatable and remarkable effects.
  They are very useful for working with random access files not
  created with Turbo Pascal. i.e. dBase II and III, BASIC, Lotus Etc.
  Using thiese seek routines with an offset which is not
  a multiple of a TP file's record length, effectively shifts where the
  normal Turbo READ and WRITE routines will begin reading records.  For
  example, a BASIC BSAVE file of the Text Screen could be considered a
  Random Access file concisting of 25 ,160 byte records, EXCEPT, BASIC
  puts seven bytes of code in front of the file.  A Turbo routine could
  be written to open a file with a 160 byte record length, and use this
  seek to skip those seven bytes, before it starts reading any records
  with Turbo's normal READ and WRITE.  OH YES! Now you will begin to do
  some of the creative and flexible File I/O not normally possible with
  PASCAL, ah but read on!

  If the I/O operation was successful, then 0 will be returned.
  If an error occurs, then the value returned will be the code for
  DOS's Error Return Table.   Errors 5 - Access denied, and 6 - Invalid
  Handle will be the most common.  If STATUS returns $25, then the
  file specified has not yet been opened.

  CAUTION:  This routines will gladly let you seek beyond the current
  end of file.
}
  function AbsoluteSeek( Var FileType; FileOffset:longint;
                         var FilePos:longint):word;

  begin
  asm
    les di,FileType
    mov AX,es:[di+2]
    and AX,0D703H
    cmp AX,0D701H
    jb @3
    mov AL,0;
    mov BX,es:[di];
    mov CX,word ptr FileOffset+2
    mov DX,word ptr FileOffset
    mov AH,42H
    int 21h
    les di,FilePos
    jc @2
    mov word ptr es:[di+2],DX
    mov word ptr es:[di],AX
    mov AX,0
    jmp @2
    @3:
    mov AX,70h
    @2:
    mov @Result,AX
    end;

 end;
{-------------------------------------------------------------------------}
   function RelativeSeek( Var FileType; RelativeOffset:longint;
                          var FilePos:longint):word;
     begin
     asm
       les di,FileType
       mov AX,es:[di+2]
       and AX,0D703H
       cmp AX,0D701H
       jb @3
       mov AL,1;
       mov BX,es:[di];
       mov CX,word ptr RelativeOffset+2
       mov DX,word ptr RelativeOffset
       mov AH,42H
       int 21h
       les di,FilePos
       jc @2
       mov word ptr es:[di+2],DX
       mov word ptr es:[di],AX
       mov AX,0
       jmp @2
       @3:
       mov AX,70h
       @2:
       mov @result,AX
       end;
    end;
{-------------------------------------------------------------------------}
Procedure EOFSeek( Var FileType; var Offset:longint; Var Status:word);
var
  FileFIB : FileRec absolute FileType;
  Reg : Registers;
  longoffset : record
    loword,hiword : word;
    end     absolute offset;
Begin
  if ((FileFIB.Mode and $D703)<$D701)  then
    begin
      Status := $25;
      Exit;
    End;
  Reg.AL := 2;
  Reg.BX := FileFIB.Handle;
  Reg.CX := 0;
  Reg.DX := 0;
  Reg.AH := $42;
  MsDos(Reg);
  If CF(Reg.Flags) then
    Status := Reg.AL
  else
    begin
    LongOffset.hiword := reg.DX;
    LongOffset.loword := reg.AX;
    Status := 0;
    end;
End;

{-------------------------------------------------------------------------}
function AbsoluteRead( Var FIleType; Var Buffer; BytesToRead: word;
                        Var BytesRead:word):word;
{  This procedure gives you the flexibility in the READ statement that
   AbsoluteSeek gives for the SEEK Statement.  This procedure will read
   from the file specified in FILETYPE, starting at the current file
   pointer (which can be set by SEEK() AbsoluteSeek() or a READ()), the
   number of bytes specified in BYTESTOREAD are place in the data
   structure specified by VARIABLE.  The file pointer is moved forward
   BYTESTOREAD bytes, regardless of the files record length.  The
   number of bytes actually read is returned in BYTESREAD.  This will
   happen if the file pointer is closer to the end of the file than
   BYTESTOREAD.  The function  will return  the DOS errorcode found in
   the AL register if the carry flag has been set. returns a 0 if no error
   condition was found.  If BYTESTOREAD = 0 and the function returns 0
   then the filepointer was at the end of the file. If this file handle
   is redirected input, say from the keyboard, the requested number of
   bytes is not always read (i.e. reading beyond the end of the file).
   Errors 5 - Access denied, and 6 - Invalid Handle will be the most
   common.  If STATUS returns hex ($)70, then the file specified has
   not yet been opened with a Turbo assign and reset or rewrite Statement,
   this is not a DOS file error.

   **** NOTE !!!  It is the programmers responsibility to insure that the
   data structure specified, is large enough to receive the bytes specified.
   if you request to read more bytes than there is room to do so, then this
   routine will write over what ever data is contiguous to the data
   structure passed.  This will get real messy so be careful!                                         }

var
  FileFIB : FIleRec absolute FileType;
  FileHandle:word;
Begin
  if ((FileFIB.Mode and $D703)<$D701) then
    begin
      AbsoluteRead := $70;
      Exit;
    End;
  FileHandle := FileFIB.Handle;
  asm
    push ds
    mov AL,0
    mov BX,FileHandle
    mov CX,BytesToRead
    lds si,Buffer
    mov dx,si
    mov AH,3FH
    int 21h
    jnc @1
    les DI,BytesRead
    mov @result,AX
    mov word ptr es:[di],0
    jmp @2
    @1:
    mov @result,0
    les DI,BytesRead
    mov es:[di],AX
    @2:
    pop ds
    end;
End;
{-------------------------------------------------------------------------}
  function AbsoluteWrite( var FIleType; Var Variable; BytestoWrite:word;
                          var BytesWritten:word):word;

{  This procedure gives you the flexibility in the WRITE statement that
   AbsoluteSeek gives for the SEEK Statement.  This procedure will write
   to the file specified in FILETYPE, starting at the current file
   pointer (which can be set by SEEK() AbsoluteSeek() READ()) or WRITE(), the
   number of bytes specified in BYTES from the data structure specified
   by VARIABLE.  The file pointer is moved forward BYTES bytes,
   regardless of the files record length.

   If the I/O operation was successful, then STATUS will return a 0.
   If an error occurs, then Status will contain the code for
   DOS's Error Return Table.   Errors 5 - Access denied, and 6 - Invalid
   Handle will be the most common.  If STATUS returns $25, then the
   file specified has not yet been opened.

   Bytes will always return the number of bytes actually written.  If this
   does not match the number requested be written, then status will return
   a $26, which most likely means the disk is full.

   **** NOTE !!!  It is the programmers responsibility to insure that the
   data structure specified, is large enough to contain the bytes specified
   for the write operation.  This will not cause any fatal errors, but could
   end up dumping a lot of junk to the disk
                                                  }
var
  FileFIB : FIleRec absolute FileType;
  Reg : Registers;

Begin
  if ((FileFIB.Mode and $D703)<$D701) then
    begin
      AbsoluteWrite := $25;
      Exit;
    End;
  Reg.AL := 0;
  Reg.BX := FileFIB.Handle;
  Reg.CX := BytesToWrite;
  Reg.DS := Seg(Variable);
  Reg.DX := Ofs(Variable);
  Reg.AH := $40;
  MsDos(Reg);
  If CF(Reg.FLAGS) then
      AbsoluteWrite := Reg.AX
    Else
      begin
      AbsoluteWrite := 0;
      BytesWritten := Reg.AX
      end;
End;
{-------------------------------------------------------------------------}
Function AbsoluteFilePos(Var FileType; Var Status:word):longint;

{  This function returns the current absolute position of the file
   pointer for the file specified in FileType.  The Turbo function
   FilePos() returns the record position of the file, while this
   function returns the actual number of bytes the pointer is offset
   from the beginning of the file.                                      }

var
  FileFIB : FileRec absolute FileType;
  Reg : Registers;
  Position: record
     case byte of
     1:(loword,hiword: word);
     2:(FP:longint);
     end;
Begin
  if ((FileFIB.Mode and $D703)<$D701) then
    begin
      Status := $25;
      Exit;
    End
  else
    Status := 0;
  Reg.AL := 1;
  Reg.BX := FileFIB.Handle;
  Reg.CX := 0;
  Reg.DX := 0;
  Reg.AH := $42;
  MsDos(Reg);
  Position.loword := reg.AX;
  Position.hiword := reg.DX;
  AbsoluteFilePos := Position.FP;
End;
{-------------------------------------------------------------------------}
function TurboFileStatus(Var FileType):Tfilestatus;

{ This function returns the status of a Turbo File Type, essentially if
  it open or closed.  }
var
  FileFIB : FileRec absolute FileType;
begin
  case lo(FileFIB.mode) of
    $B0 : TurboFileStatus := Closed;
    $B1,$B2,$B3 : TurboFileStatus := Open;
     else TurboFileStatus := Unknown;
  end;
end;


{-------------------------------------------------------------------------}
Function FileRecordLength(Var FileType):word;

{  This is a simple function that returns what Turbo has set the record
   length of the file specified in FileType.  A zero value is returned
   if the file is closed.  If the file is a textfile the results of this
   function are not the Record Length of the file but the size of the
   text buffer Turbo is using. See Turbo Manual for more info (Ver 4.0
   page 298).                                     }

Var
  FIB:FileRec absolute FileType;
Begin
  FileRecordLength := FIB.recsize;
End;
{-------------------------------------------------------------------------}
{ The following routines are just a convienent way to access information
  conatined in Turbo's file record structure . }
function TurboFileMode(Var FileType):word;
var
  FileFIB : FileRec absolute FileType;
begin
  TurboFileMode := FileFIB.mode;
end;
{-------------------------------------------------------------------------}
function TurboFileHandle(Var FileType):integer;
var
  FileFIB : FileRec absolute FileType;
begin
  TurboFIleHandle := FileFIB.Handle;
end;
{-------------------------------------------------------------------------}
procedure ForceUpdate(var FileType;var status : word);
var
  FileFIB : FileRec absolute FileType;
  Reg : Registers;
  NewHandle : word;
begin
  if ((FileFIB.Mode and $D703)<$D701)  then
    begin
      Status := $25;
      Exit;
    End;
  Reg.AL := 0;
  Reg.BX := FileFIB.Handle;
  Reg.AH := $45;
  MsDos(Reg);
  If CF(Reg.Flags) then
    begin
    Status := Reg.AL;
    exit;
    end;

  Reg.BX := Reg.AX;
  Reg.AL := 0;
  Reg.AH := $3E;
  MsDos(Reg);
  If CF(Reg.Flags) then
    Status := Reg.AL
  else
    Status := 0
End;
{---------------------------------------}
    function FastBinaryCopy(var FileTypeSource; var FileTypeTarget):word;
      var
        Buffer: pointer;
        MoveSize:word;
        ByteIn,BytesRead,junk:word;
        Error : word;
        Temp:longint;
      begin
      error := 0;
      if MaxAvail < 256 then
        error := $ff
      else
        begin
        if MaxAvail < 9*512 then
          MoveSize := MaxAVail
        else
          MoveSize := 9*512;
        getmem(Buffer,MoveSize);
        Temp := absoluteFilePos(FileTypeSource,error);
        repeat
          ByteIn := MoveSize;
          error := absoluteRead(FileTypeSource,buffer^,ByteIn,BytesRead);
          if BytesRead>0 then
            error := absolutewrite(FileTypeTarget,buffer^,BytesRead,junk);
          until (error<>0)or(BytesRead=0);
        freemem(Buffer,MoveSize);
        end;
      AbsoluteSeek(FileTypeSource,Temp,Temp);
      FastBinaryCopy := error;
      end;

    {--------------------------------------------}
        function FIleCopy(Source,Target:TFilePath):word;
      var
        SourceF,TargetF:File;
        Error : word;
        FT,FS:longint;
        DriveID:byte;
      {--------------------}
      function ioOk:boolean;
        begin
        if error=0 then
          begin
          Error := ioresult;
          if Error>0 then
            ioOk := false
          else
            ioOk := true;
          end;
        end;
      {--------------------}
      begin
      if Source=Target then
        begin
        FileCopy := 1;
        exit;
        end
      else
        error := 0;
      assign(SourceF,Source);
      reset(SourceF);

      if ioOk then
        begin
        FS := FileSize(SourceF);
        if Target[2]=':' then
          DriveID := byte(Target[1]) and $f
        else
          DriveID := 0;
        if Diskfree(DriveID)<FS then
          Error := 1
        else
          begin
          GetFTime(SourceF,FT);
          assign(TargetF,Target);
          rewrite(TargetF);
          if ioOk then
            begin
            error := FastBinaryCopy(SourceF,TargetF);
            SetFTime(TargetF,FT);
            close(TargetF);
            end;
          Close(SourceF);
          end;
        end;
      FileCopy := error;
      end;


end.